home *** CD-ROM | disk | FTP | other *** search
/ Atari Mega Archive 1 / Atari Mega Archive - Volume 1.iso / gnu / emacs / emacs1857 / src_d2.zoo / source / callint.c < prev    next >
C/C++ Source or Header  |  1991-12-02  |  15KB  |  513 lines
  1. /* Call a Lisp function interactively.
  2.    Copyright (C) 1985, 1986 Free Software Foundation, Inc.
  3.  
  4. This file is part of GNU Emacs.
  5.  
  6. GNU Emacs is free software; you can redistribute it and/or modify
  7. it under the terms of the GNU General Public License as published by
  8. the Free Software Foundation; either version 1, or (at your option)
  9. any later version.
  10.  
  11. GNU Emacs is distributed in the hope that it will be useful,
  12. but WITHOUT ANY WARRANTY; without even the implied warranty of
  13. MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  14. GNU General Public License for more details.
  15.  
  16. You should have received a copy of the GNU General Public License
  17. along with GNU Emacs; see the file COPYING.  If not, write to
  18. the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.  */
  19.  
  20.  
  21. #include "config.h"
  22. #include "lisp.h"
  23. #include "buffer.h"
  24. #include "commands.h"
  25. #include "window.h"
  26.  
  27. Lisp_Object global_map;
  28.  
  29. extern int num_input_chars;
  30.  
  31. Lisp_Object Vprefix_arg, Vcurrent_prefix_arg, Qminus;
  32. Lisp_Object Qcall_interactively;
  33. Lisp_Object Vcommand_history;
  34.  
  35. extern Lisp_Object ml_apply ();
  36. extern Lisp_Object Fread_buffer (), Fread_key_sequence (), Fread_file_name ();
  37.  
  38. /* This comment supplies the doc string for interactive,
  39.    for make-docfile to see.  We cannot put this in the real DEFUN
  40.    due to limits in the Unix cpp.
  41.  
  42. DEFUN ("interactive", Ffoo, Sfoo, 0, 0, 0,
  43.  "Specify a way of parsing arguments for interactive use of a function.\n\
  44. For example, write\n\
  45.   (defun fun (arg) \"Doc string\" (interactive \"p\") ...use arg...)\n\
  46. to make arg be the prefix numeric argument when foo is called as a command.\n\
  47. This is actually a declaration rather than a function;\n\
  48.  it tells  call-interactively  how to read arguments\n\
  49.  to pass to the function.\n\
  50. When actually called,  interactive  just returns nil.\n\
  51. \n\
  52. The argument of  interactive  is usually a string containing a code letter\n\
  53.  followed by a prompt.  (Some code letters do not use I/O to get\n\
  54.  the argument and do not need prompts.)  To prompt for multiple arguments,\n\
  55.  give a code letter, its prompt, a newline, and another code letter, etc.\n\
  56. If the argument is not a string, it is evaluated to get a list of\n\
  57.  arguments to pass to the function.\n\
  58. Just  (interactive)  means pass no args when calling interactively.\n\
  59. \nCode letters available are:\n\
  60. a -- Function name: symbol with a function definition.\n\
  61. b -- Name of existing buffer.\n\
  62. B -- Name of buffer, possibly nonexistent.\n\
  63. c -- Character.\n\
  64. C -- Command name: symbol with interactive function definition.\n\
  65. d -- Value of point as number.  Does not do I/O.\n\
  66. D -- Directory name.\n\
  67. f -- Existing file name.\n\
  68. F -- Possibly nonexistent file name.\n\
  69. k -- Key sequence (string).\n\
  70. m -- Value of mark as number.  Does not do I/O.\n\
  71. n -- Number read using minibuffer.\n\
  72. N -- Prefix arg converted to number, or if none, do like code `n'.\n\
  73. p -- Prefix arg converted to number.  Does not do I/O.\n\
  74. P -- Prefix arg in raw form.  Does not do I/O.\n\
  75. r -- Region: point and mark as 2 numeric args, smallest first.  Does no I/O.\n\
  76. s -- Any string.\n\
  77. S -- Any symbol.\n\
  78. v -- Variable name: symbol that is user-variable-p.\n\
  79. x -- Lisp expression read but not evaluated.\n\
  80. X -- Lisp expression read and evaluated.\n\
  81. In addition, if the first character of the string is '*' then an error is\n\
  82.  signaled if the buffer is read-only.\n\
  83.  This happens before reading any arguments.")
  84. */
  85.  
  86. /* ARGSUSED */
  87. DEFUN ("interactive", Finteractive, Sinteractive, 0, UNEVALLED, 0,
  88.   0 /* See immediately above */)
  89.   (args)
  90.      Lisp_Object args;
  91. {
  92.   return Qnil;
  93. }
  94.  
  95. /* Quotify EXP: if EXP is constant, return it.
  96.    If EXP is not constant, return (quote EXP).  */
  97. Lisp_Object
  98. quotify_arg (exp)
  99.      register Lisp_Object exp;
  100. {
  101.   if (XTYPE (exp) != Lisp_Int && XTYPE (exp) != Lisp_String
  102.       && !NULL (exp) && !EQ (exp, Qt))
  103.     return Fcons (Qquote, Fcons (exp, Qnil));
  104.  
  105.   return exp;
  106. }
  107.  
  108. /* Modify EXP by quotifying each element (except the first).  */
  109. Lisp_Object
  110. quotify_args (exp)
  111.      Lisp_Object exp;
  112. {
  113.   register Lisp_Object tail;
  114.   register struct Lisp_Cons *ptr;
  115.   for (tail = exp; CONSP (tail); tail = ptr->cdr)
  116.     {
  117.       ptr = XCONS (tail);
  118.       ptr->car = quotify_arg (ptr->car);
  119.     }
  120.   return exp;
  121. }
  122.  
  123. char *callint_argfuns[]
  124.     = {"", "point", "mark", "region-beginning", "region-end"};
  125.  
  126. static void
  127. check_mark ()
  128. {
  129.   Lisp_Object tem = Fmarker_buffer (current_buffer->mark);
  130.   if (NULL (tem) || (XBUFFER (tem) != current_buffer))
  131.     error ("The mark is not set now");
  132. }
  133.  
  134.  
  135. DEFUN ("call-interactively", Fcall_interactively, Scall_interactively, 1, 2, 0,
  136.   "Call FUNCTION, reading args according to its interactive calling specs.\n\
  137. The function contains a specification of how to do the argument reading.\n\
  138. In the case of user-defined functions, this is specified by placing a call\n\
  139. to the function `interactive' at the top level of the function body.\n\
  140. See `interactive'.\n\
  141. \n\
  142. Optional second arg RECORD-FLAG non-nil\n\
  143. means unconditionally put this command in the command-history.\n\
  144. Otherwise, this is done only if an arg is read using the minibuffer.")
  145.   (function, record)
  146.      Lisp_Object function, record;
  147. {
  148.   Lisp_Object *args, *visargs;
  149.   unsigned char **argstrings;
  150.   Lisp_Object fun;
  151.   Lisp_Object funcar;
  152.   Lisp_Object specs;
  153.   Lisp_Object teml;
  154.  
  155.   Lisp_Object prefix_arg;
  156.   unsigned char *string;
  157.   unsigned char *tem;
  158.   int *varies;
  159.   register int i, j;
  160.   int count, foo;
  161.   char prompt[100];
  162.   char prompt1[100];
  163.   char *tem1;
  164.   int arg_from_tty = 0;
  165.   struct gcpro gcpro1, gcpro2, gcpro3, gcpro4;
  166.   extern char *index ();
  167.  
  168.   /* Save this now, since use ofminibuffer will clobber it. */
  169.   prefix_arg = Vcurrent_prefix_arg;
  170.  
  171. retry:
  172.  
  173.   fun = function;
  174.   while (XTYPE (fun) == Lisp_Symbol && !EQ (fun, Qunbound)) fun = XSYMBOL (fun)->function;
  175.  
  176.   if (XTYPE (fun) == Lisp_Subr)
  177.     {
  178.       string = (unsigned char *) XSUBR (fun)->prompt;
  179.       if (!string)
  180.     {
  181.     lose:
  182.       function = wrong_type_argument (Qcommandp, function, 0);
  183.       goto retry;
  184.     }
  185.       else if ((int) string == 1)
  186.     return call0 (function);
  187.     }
  188.   else if (!CONSP (fun))
  189.     goto lose;
  190.   else if (funcar = Fcar (fun), EQ (funcar, Qautoload))
  191.     {
  192.       GCPRO2 (function, prefix_arg);
  193.       do_autoload (fun, function);
  194.       UNGCPRO;
  195.       goto retry;
  196.     }
  197.   else if (EQ (funcar, Qlambda))
  198.     {
  199.       specs = Fassq (Qinteractive, Fcdr (Fcdr (fun)));
  200.       if (NULL (specs))
  201.     goto lose;
  202.       specs = Fcar (Fcdr (specs));
  203.       if (XTYPE (specs) == Lisp_String)
  204.     string = XSTRING (specs)->data;
  205.       else
  206.     {
  207.       i = num_input_chars;
  208.       specs = Feval (specs);
  209.       if (i != num_input_chars || !NULL (record))
  210.         Vcommand_history
  211.           = Fcons (Fcons (function, quotify_args (Fcopy_sequence (specs))),
  212.                Vcommand_history);
  213.       return apply1 (function, specs);
  214.     }
  215.     }
  216.   else if (EQ (funcar, Qmocklisp))
  217.     return ml_apply (fun, Qinteractive);
  218.   else
  219.     goto lose;
  220.  
  221.   /* Here if function specifies a string to control parsing the defaults */
  222.  
  223.   /* First character '*' means barf if buffer read-only */
  224.   if (*string == '*')
  225.     { string++;
  226.       if (!NULL (current_buffer->read_only))
  227.     Fbarf_if_buffer_read_only ();
  228.     }
  229.  
  230.   tem = string;
  231.   for (j = 0; *tem; j++)
  232.     {
  233.       if (*tem == 'r') j++;
  234.       tem = (unsigned char *) index (tem, '\n');
  235.       if (tem) tem++;
  236.       else tem = (unsigned char *) "";
  237.     }
  238.   count = j;
  239.  
  240.   args = (Lisp_Object *) alloca ((count + 1) * sizeof (Lisp_Object));
  241.   visargs = (Lisp_Object *) alloca ((count + 1) * sizeof (Lisp_Object));
  242.   argstrings = (unsigned char **) alloca ((count + 1) * sizeof (char *));
  243.   varies = (int *) alloca ((count + 1) * sizeof (int));
  244.  
  245.   for (i = 0; i < (count + 1); i++)
  246.     {
  247.       args[i] = Qnil;
  248.       visargs[i] = Qnil;
  249.       varies[i] = 0;
  250.     }
  251.  
  252.   GCPRO4 (prefix_arg, function, *args, *visargs);
  253.   gcpro3.nvars = (count + 1);
  254.   gcpro4.nvars = (count + 1);
  255.  
  256.   tem = string;
  257.    for (i = 1; *tem; i++)
  258.     {
  259.       strncpy (prompt1, tem + 1, sizeof prompt1 - 1);
  260.       prompt1[sizeof prompt1 - 1] = 0;
  261.       tem1 = index (prompt1, '\n');
  262.       if (tem1) *tem1 = 0;
  263.       /* Fill argstrings with a vector of C strings
  264.      corresponding to the Lisp strings in visargs.  */
  265.